/* REXX _cim_hunter.zrx by the reverend (build 97)                            */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:16        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* rev. 0 - initial release                                                   */

call zoctimeout 60
call zocsynctime 500
globals=_setglobals()
call on halt name _halt

call _newline _ansi("bt;fgr")
parse value _getgameinfo() with spath ";" iname ";" game
parse value zocgetglobaloption("DownloadAltPath") with . '="' destfolder '"'
destfolder=destfolder||"\"

ns=_ini_askint("how many sectors in this game?", 5000, iname, game, "ns")
if ns<1 | ns>20000 then call _error "number out of range"

log=_yesno("log to file?")
if log then do
 fname="cim_hunter.txt"
 fname=zocask("filename?", fname)
 if fname="##CANCEL##" then call _quit "script cancelled by user."
 fname=destfolder||fname
 if \_fileopenw(fname) then call _error "unable to create/open file "||fname||"."
 else do
  call lineout fname, ""
  call lineout fname, "CIMHUNTER SESSION: "||date("N")||", "||time("N")
  call _fileclose fname
 end /*else*/
end /*if*/

call zocsend "^^?"
if zocwait("Interrogation Modes")=640 then call _error "timeout"
if zocwait(":")=640 then call _error "timeout"
call zocsuppressoutput 1

pdata.=""
done=0
init=1
i=1
j=abs(i-2)+1
cutoff=49
buflen=1024*1024

do FOREVER

 call zocwriteln "getting cim data..."
 call zocreceivebuf buflen
 call zocsend "r"
 ans=zocwaitmux("%",":")
 do while ans=0
  ans=zocwaitmux("%",":")
 end /*do*/
 select
  when ans=0 then nop
  /* was having problems on bbs getting bogus spaces, so i added the "_" removal */
  when ans=1 then buff=translate(zocreceivebuf(0),"  _",d2c(0)||d2c(10)||" ")
  when ans=640 then call _error "timeout"
  otherwise nop
 end /*select*/
 if length(buff)=buflen then call _error "buffer overflow"

 /* "_" removal */
 buff=translate(_space(buff,0)," ","_")

 do k=1 to ns
  pdata.i.k=""
 end /*do*/

 ii=1
 jj=pos(d2c(13),buff,ii)
 do while jj>0
  line=substr(buff,ii,jj-ii)
  select
   when line=":" then jj=0
   when line="" then nop
   otherwise do
    line=zocstring("REPLACE",_space(line),"- ","-")
    parse var line sec info
    pdata.i.sec=info
   end /*otherwise*/
  end /*select*/
  if jj>0 then do
   ii=jj+1
   jj=pos(d2c(13),buff,ii)
  end /*if*/
 end /*do*/

 if init then init=0
 else do
  list=""
  do k=1 to ns
   qq.=0
   pp.=0
   if pdata.i.k\="" then parse var pdata.i.k qq.1.1 pp.1.1 "%" qq.1.2 pp.1.2 "%" qq.1.3 pp.1.3 "%"
   if pdata.j.k\="" then parse var pdata.j.k qq.2.1 pp.2.1 "%" qq.2.2 pp.2.2 "%" qq.2.3 pp.2.3 "%"
   if abs(qq.1.1-qq.2.1)>cutoff | abs(qq.1.2-qq.2.2)>cutoff | abs(qq.1.3-qq.2.3)>cutoff then do
    list=list||k
    pt.=""
    do kk=1 to 3
     if qq.1.kk<0 | qq.2.kk<0 then pt.kk="B"
     else pt.kk="S"
    end /*do*/
    list=list||"."||pt.1||pt.2||pt.3
    do kk=1 to 3
     if pt.kk="B" then list=list||"."||qq.2.kk-qq.1.kk
     else list=list||"."||qq.1.kk-qq.2.kk
    end /*do*/
    list=list||" "
   end /*if*/
  end /*do*/
  list=strip(list)
  if list\="" then do
   call zocsend "q"
   call zocsend "'^M"
   if _verbose then call zocsend "REV-SCRIPT: _cim_hunter report^M"
   do kk=1 to words(list)
    if \_verbose then call zocsend " CIM:"
    call zocsend " "||word(list,kk)||"^M"
    call zocwriteln " "||word(list,kk)
   end /*do*/
   call zocsend "^M"
   call _beep "alert.wav"
   call zocsend "^^?"
   if zocwait("Interrogation Modes")=640 then call _error "timeout"
   if zocwait(":")=640 then call _error "timeout"
   if log then do
    if _fileopenw(fname) then do
     do kk=1 to words(list)
      call lineout fname, " "||word(list,kk)
     end /*do*/
     call _fileclose fname
    end /*if*/
   end /*if*/
  end /*if*/
 end /*else*/

 i=abs(i-2)+1
 j=abs(i-2)+1

end /*do*/

call zocsuppressoutput 0
call zocsend "   ^Mq"
call _quit

exit

/* _halt v.1 */

_halt:
 call zocsuppressoutput 0
 call zocsend "   ^Mq"
 call zocwriteln
 call zocwriteln "^[[1;33m<< script aborted by user. >>^[[0;35m "
 exit
return

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _getgameinfo v.5 **/
    _getgameinfo: procedure expose (globals)
     spath=_getscriptpath()
     base=spath||"script.ini"
    
     if arg(1,"E") then fname=arg(1)
     else fname=base
    
     parse value zocgetglobaloption("WindowTitle") with . '="' game '"'
     if fname\=base | game="" | game="%ZOCORHOST% %OPTIONS%" then do
      list=_ini_getheadings(fname)
      if list="##EOF##" then game="##EOF##"
      else do
       templist=""
       do i=1 to _dwords(list,";")
        temp=_dword(list,i,";")
        if left(temp,1)\="*" then do
         if templist="" then templist=temp
         else templist=templist||";"||temp
        end /*if*/
       end /*do*/
       list=templist
       game=_drequestlist("select a game:", list, ";", "c")
      end /*else*/
     end /*do*/
    
     call zocwrite _ansi("bt;fgr")||"< using "
     if length(fname)>17 then call zocwrite "..."
     call zocwriteln right(fname,min(length(fname),17))||" - ["||game||"] >"
    
     rslt=spath||";"||fname||";"||game
    return rslt

/** _ini_askint v.5 **/
    _ini_askint: procedure expose (globals)
     if \arg(1,"E") then msg="enter an integer"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_askint"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if _stripint(default)\=default then call _error "invalid parameter in _ini_askint"
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=_stripint(default)
      when rslt="##EOF##"                     then rslt=_askint(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then rslt=_stripint(rslt)
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwriteln right(fname,min(length(fname),17))||" - "||key||"="||rslt||" >"
       rslt=_stripint(rslt)
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _yesno v.3 **/
    _yesno: procedure expose (globals)
     if arg(1,"E") then msg=arg(1)
     else msg="yes or no"
     if arg(2)="yn" then rslt=zocrequest(msg||" (ESC=no)", "yes", "no")
                    else rslt=zocrequest(msg, "yes", "no", "cancel")
     select
      when rslt="cancel" then call _quit "script cancelled by user.", "nocopy"
      when rslt="##CANCEL##" & arg(2)\="yn" then call _quit "script cancelled by user.", "nocopy"
      when rslt="yes" then rslt=1
      otherwise rslt=0
     end /*select*/
    return rslt

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _fileopenw v.3 **/
    _fileopenw: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenw"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN WRITE"
      call stream arg(1), "C", "SEEK <0"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=_filenew(arg(1))
    return rslt

/** _fileclose v.3 **/
    _fileclose: procedure expose (globals)
     if \arg(1,"E") then call _error "missing argument in _fileclose"
     call stream arg(1), "C", "CLOSE"
    return

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _getscriptpath v.1 **/
    _getscriptpath:
     parse value zocgetglobaloption("ScriptPath") with . '="' spath '"'
     spath=dosfname(spath)
     if right(spath,1)\="\" then spath=spath||"\"
     if \dosisdir(spath) then call _error "invalid path in _getscriptpath"
    return spath

/** _ini_getheadings v.5 **/
    _ini_getheadings: procedure expose (globals)
     if arg(1,"E") then fname=arg(1)
     else call _error "missing parameter in _ini_getheadings"
     if arg(2,"E") then delim=left(arg(2),1)
     else delim=";"
     list=""
     if _fileopenr(fname) then do
      do while \_fileeof(fname)
       line=strip(linein(fname))
       if left(line,1)="[" then do
        if list="" then list=strip(translate(line,"  ","[]"))
        else list=list||delim||strip(translate(line,"  ","[]"))
       end /*if*/
      end /*do*/
      call _fileclose fname
     end /*do*/
     if list="" then list="##EOF##"
    return list

/** _drequestlist v.3 **/
    _drequestlist: procedure expose (globals)
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     select
      when i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
      when i<0 then rslt="##CANCEL##"
      otherwise rslt=_dword(arg(2),i+1,arg(3))
     end /*select*/
    return rslt

/** _stripint v.4 **/
    _stripint: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789"," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if \datatype(rslt,"W") then rslt=""
    return rslt

/** _ini_read v.1 **/
    _ini_read: procedure expose (globals)
     /* argument check */
     do i=1 to 3
      if \arg(i,"E") | arg(i,"O") then call _error "missing arguments in _ini_read."
     end /*do*/
    
     /* name arguments */
     fname=arg(1)
     s=strip(arg(2))
     k=strip(arg(3))
    
     if _fileopenr(fname) then do
      done=0
      found=0
      insection=0
      do while \done & \_fileeof(fname)
       line=strip(linein(fname))
       select
        when left(line,1)=";" then nop
        when line="["||s||"]" then insection=1
        when insection & left(line,1)="[" then done=1
        when insection & left(line,length(k)+1)=k||"=" then do
         v=strip(substr(line,length(k)+2))
         done=1
         found=1
        end /*when*/
        otherwise nop
       end /*select*/
      end /*do*/
      call _fileclose fname 
      if \found then v="##EOF##"
     end /*if*/
     else v="##EOF##"
    
    return v

/** _askint v.2 **/
    _askint: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an integer:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripint(rslt)\=rslt | rslt=""
      default=rslt||" [please enter an integer or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _fileready v.1 **/
    _fileready: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileready"
     if stream(arg(1), "S")\="NOTREADY" then rslt=1; else rslt=0
    return rslt

/** _filenew v.4 **/
    _filenew: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _filenew"
     if arg(2,"E") & lower(arg(2))="delete" then call dosdel arg(1)
     if _fileexists(arg(1)) then rslt=0
     else do
      call stream arg(1), "C", "OPEN WRITE"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*else*/
    return rslt

/** _fileopenr v.4 **/
    _fileopenr: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenr"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN READ"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=0
    return rslt

/** _fileeof v.4 **/
    _fileeof: procedure expose (globals)
     rslt=\lines(arg(1))
    return rslt